浮云Excel分享 2018-06-27 10:23:07
网友有这样一个表格：
Excel VBA 拆分工作薄-数组方法
B~K列每行有1000+的数据，需把每列最后单元格网上500个数据，分配到指定文件夹的各指定工作簿的A列。（注：每个文件夹中包含相同的工作簿）
具体的要求如下：
把B列最后单元格往上500个数据，填入工作簿名"白色"的A列。
把C列最后单元格往上500个数据，填入工作簿名"金丝"的A列。
把D列最后单元格往上500个数据，填入工作簿名"银丝"的A列。
把E列最后单元格往上500个数据，填入工作簿名"咖啡色"的A列。
把F列最后单元格往上500个数据，填入工作簿名"黑金刚"的A列。
把G列最后单元格往上500个数据，填入工作簿名"天蓝色"的A列。
把H列最后单元格往上500个数据，填入工作簿名"浅蓝色"的A列。
把I列最后单元格往上500个数据，填入工作簿名"橘黄色"的A列。
把J列最后单元格往上500个数据，填入工作簿名"雪牙色"的A列。
把K列最后单元格往上509个数据，填入工作簿名"浅咖啡色"的A列。
根据要求，整理一下思路如下：
把每列的最后500个数据放入数组（数组的赋值）
按照Q2单元格给的文件夹名称，打开对应文件夹下面对应的工作薄（打开工作薄）
把放入了500个数据的数组，赋值给对应的表格（读取数组的值）
自动关闭表格（关闭工作薄
重复上述步骤
思路有了，但是也有最大一个难点：如何保证读取了B列的数据，确定保证能打开“白色”的工作表
先看一下已经写好的代码运行结果：
Excel VBA 拆分工作薄-数组方法
具体代码如下：
代码解析：
1.把文档的名称全部放入brr数组。
2.ThisWorkbook.Path 表示获取当前打开文档的路径。
3.Workbooks(str & ".xlsx").Close SAVECHANGES:=True 表示关闭后确认。
4.Erase arr 表示清空数组
Sub HCH()
'关闭保存时弹出的警告窗口
Application.DisplayAlerts = False
'关闭屏幕刷新
Application.ScreenUpdating = False
'定义参数及数组
Dim i
Dim num
Dim str
Dim arr
Dim brr()
For num = 2 To 11
'提出列结果的最后一列
i = Sheet1.Cells(1, num).End(xlDown).Row
'需要使用的最后500行数据，放入arr数组
arr = Range(Cells(i - 499, num), Cells(i, num))
'文档的名称放入数组
brr = Array("白色", "金丝", "银丝", "咖啡色", "黑金刚", "天蓝色", "浅蓝色", "橘黄色", "雪牙色", "浅咖啡色")
str = brr(num - 2)
'跟随for循环打开文档
Workbooks.Open ThisWorkbook.Path & "" & Range("Q1") & "" & str & ".xlsx"
Sheets(1).Activate
'把需要的数据，进行赋值
Range("A1:A500") = arr
'关闭文件并保存
Workbooks(str & ".xlsx").Close SAVECHANGES: = True
'清空arr数组，为重新赋值做准备
Erase arr
Next
'打开保存时弹出的警告窗口
Application.DisplayAlerts = True
'打开屏幕刷新
Application.ScreenUpdating = True
End Sub
本页共68段，1608个字符，3130 Byte(字节)